home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / jockguts.arc / READTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-28  |  36KB  |  1,108 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.01                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:  ReadTTT5          }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {History:         2/24/89   5.00a  Reversed return codes in ReadLine
  18.                   3/05/89   5.00b  Added Box proc to Read_Real
  19. }
  20.  
  21. {$S-,R-,V-,D-}       
  22.  
  23. Unit ReadTTT5;
  24.  
  25. Interface
  26.  
  27. Uses CRT,FastTTT5,WinTTT5,StrnTTT5,KeyTTT5;
  28.  
  29. Type
  30.    R_Display = record
  31.                     WhiteSpace  : char;        {used to pad input field - default ··········} 
  32.                     AllowEsc    : boolean;     {allow the he user to escape?} 
  33.                     Beep        : Boolean;     {allow the old proverbial beep} 
  34.                     Insert      : boolean;     {initially in insert mode?} 
  35.                     BegCursor   : boolean;     {place cursor at beginning of line} 
  36.                     AllowNull   : boolean;     {allow user to input a '' or null value} 
  37.                     RightJustify: Boolean;     {right justify string on termination} 
  38.                     EraseDefault: Boolean;     {clear entry of alphanumeric pressed} 
  39.                     SuppressZero: Boolean;     {have empty field is value = zero}
  40.                     FCol        : byte;        {normal foreground color of input field}
  41.                     BCol        : byte;        {normal background of input field}
  42.                     HiFCol      : byte;        {highlighted fgnd color for Read_Select}
  43.                     HiBCol      : byte;        {highlighted bgnd color for Read_Select}
  44.                     LoFCol      : byte;        {normal fgnd color for Read_Select}
  45.                     LoBCol      : byte;        {normal bgnd color for Read_Select}
  46.                     PFcol       : byte;        {prompt foreground color}
  47.                     PBCol       : byte;        {prompt background color}
  48.                     BoxFCol     : byte;        {box foreground color}
  49.                     BoxBCol     : byte;        {Box background color}
  50.                     Msg_FCol    : byte;        {Foreground color for error messages}
  51.                     Msg_BCol    : byte;        {Background color for error messages}
  52.                     Msg_Line    : byte;        {line for error messages}
  53.                     End_chars   : set of char; {end of input chars}
  54.                     RealDP      : byte;        {no of decimal places on real}
  55.                end;
  56.  
  57. const
  58.     NoPrompt:string[1] = '';
  59. Var
  60.   RTTT : R_Display;
  61.   R_Char : char;
  62.   R_Null : boolean;
  63.  
  64. Procedure Default_Settings;
  65. Procedure ReadLine(X,Y,L,F,B:byte;var Text: string;var Retcode:integer);
  66. Procedure Read_String(X,Y,L:byte;
  67.                       Prompt:StrScreen; 
  68.                       BoxType: byte;
  69.                       Var Txt:StrScreen);
  70. Procedure Read_String_Upper(X,Y,L:byte;
  71.                             Prompt:StrScreen;
  72.                             BoxType: byte;
  73.                             Var Txt:StrScreen);
  74. Procedure Read_Password(X,Y,L:byte;
  75.                         Prompt:StrScreen;
  76.                         BoxType: byte;
  77.                         Var Txt:StrScreen);
  78. Procedure Read_Alpha(X,Y,L:byte;
  79.                      Prompt:StrScreen;
  80.                      BoxType: byte;
  81.                      Var Txt:StrScreen);
  82. Procedure Read_YN(X,Y:byte;
  83.                   Prompt:StrScreen;
  84.                   BoxType: byte;
  85.                   Var Yes:Boolean);
  86. Procedure Read_Byte(X,Y,L:byte; 
  87.                     Prompt:StrScreen;
  88.                     BoxType: byte;
  89.                     Var B : Byte;
  90.                     Min, Max : Byte);
  91. Procedure Read_Word(X,Y,L:byte; 
  92.                     Prompt:StrScreen;
  93.                     BoxType: byte;
  94.                     Var W : word;
  95.                     Min, Max : word);
  96. Procedure Read_Int(X,Y,L:byte;
  97.                    Prompt:StrScreen;
  98.                    BoxType: byte;
  99.                    Var W : integer;
  100.                    Min, Max : integer);
  101. Procedure Read_LongInt(X,Y,L:byte;
  102.                        Prompt:StrScreen;
  103.                        BoxType: byte;
  104.                        Var W : longint;
  105.                        Min, Max : longint);
  106. Procedure Read_Real(X,Y,L:byte;
  107.                     Prompt:StrScreen;
  108.                     BoxType: byte;
  109.                     Var W : real;
  110.                     Min, Max : real);
  111. Procedure Read_Select(X,Y:byte;Pmt,Txt:StrScreen;var Choice:byte);
  112. Implementation
  113.  
  114. CONST
  115.     PassChar    = #15;
  116.     CursorRight = #205;
  117.     CursorLeft  = #203;
  118.     CursorDown  = #208;
  119.     CursorUp    = #200;
  120.     EnterKey    = #13;
  121.     EscKey      = #27;
  122.     EndKey      = #207;
  123.     HomeKey     = #199;
  124.     DelKey      = #211;
  125.     Backspace   = #8;
  126.     InsKey      = #210;
  127.     Zap         = #160;      {Alt D to delete the field}
  128.     MinInt              = -32768;
  129.     MaxLongInt:longint  =  2147483647;
  130.     MinLongInt:longint  = -2147483647;
  131.     MaxWord             =  65535;
  132.     MinWord             =  0;
  133.     
  134. VAR
  135.    Cursor_X,
  136.    Cursor_Y,
  137.    ScanTop,
  138.    ScanBot   : byte;
  139.  
  140. Procedure Default_Settings;
  141. begin
  142.    with RTTT do
  143.    begin
  144.        WhiteSpace   := #250;
  145.        Beep         := true;
  146.        BegCursor    := false;
  147.        Insert       := false;
  148.        AllowEsc     := true;
  149.        AllowNull    := true;
  150.        RightJustify := false;
  151.        EraseDefault := false;
  152.        SuppressZero := true;
  153.        End_Chars := [#13];  {Enter}
  154.        RealDP := 2;  
  155.        If BaseOfScreen = $B000 then
  156.        begin
  157.            FCol := black;
  158.            BCol := lightgray;
  159.            HiFCol := white;
  160.            HiBCol := black;
  161.            LoFCol := lightgray;
  162.            LoBCol := black;
  163.            PFCol := white;
  164.            PBCol := black;
  165.            BoxFCol := white;
  166.            BoxBCol := black;
  167.            Msg_FCol := white;
  168.            Msg_BCol := black;
  169.            Msg_Line := 0;
  170.        end
  171.        else
  172.        begin
  173.            FCol := black;
  174.            BCol := lightgray;
  175.            HiFCol := black;
  176.            HiBCol := lightgray;
  177.            LoFCol := lightgray;
  178.            LoBCol := black;
  179.            PFCol := white;
  180.            PBCol := black;
  181.            BoxFCol := white;
  182.            BoxBCol := black;
  183.            Msg_FCol := lightred;
  184.            Msg_BCol := black;
  185.            Msg_Line := 0;
  186.        end;
  187.    end;
  188. end;
  189.  
  190. Procedure Clang;
  191. begin
  192.     If RTTT.Beep then
  193.     begin
  194.         sound(500);
  195.         delay(50);
  196.         nosound;
  197.     end;
  198. end;
  199.  
  200. Procedure Read_Line(X,Y,L,F,B,Format:byte;
  201.                      var Text   :string);
  202. {
  203. X is X coord of first character in field
  204. Y is Y coord of field
  205. L is the maximum length of the input field
  206. F is the foreground color
  207. B is the background color
  208. Fornat Codes:      1   Any String
  209.                    2   Force Upper String
  210.                    3   Yes/No
  211.                    4   Alphabetics only
  212.                    5   Integer
  213.                    6   LongInteger
  214.                    7   Real
  215.                    8   Word
  216.                    (*   Maybe
  217.                    9   Date    (MM/DD/YY)
  218.                    10  Date    (DD/MM/YY)
  219.                    *)
  220.                    11  Echo a Password
  221. Text is a string updated with the string equivalent of user input
  222. }
  223. var
  224.     TempText : string;
  225.     CursorPos : byte;
  226.     InsertMode,
  227.     Password,
  228.     Alldone : boolean;
  229.     FirstCharPress: boolean;
  230.     Ch : char;
  231.  
  232.     Procedure Check_Parameters;
  233.     begin
  234.         TempText := Text;
  235.         If length(TempText) > L then
  236.            Delete(Temptext,L+1,length(TempText)-L);
  237.         If not X in [1..80] then
  238.            X := 1;
  239.         If X + L - 1 > 80 then X := 81 - L;
  240.         If not Y in [1..25] then
  241.            Y := 1;
  242.         If RTTT.BegCursor then
  243.            CursorPos := 1
  244.         else
  245.         begin
  246.             If length(TempText) < L then
  247.                CursorPos := length(TempText) + 1
  248.             else
  249.                CursorPos := length(TempText);
  250.         end;
  251.         InsertMode  := RTTT.Insert;
  252.         Alldone := False;
  253.         If Format = 11 then
  254.         begin
  255.             Password := true;
  256.             Format := 1;
  257.         end
  258.         else
  259.            Password := false;
  260.     end;  {sub Proc Check_Parameters}
  261.  
  262.     Function FillWhiteSpace(Str:string):string;
  263.     var I : integer;
  264.     begin
  265.         If Password then
  266.            Str := replicate(length(Str),PassChar);
  267.         while length(Str) < L do
  268.               Str := Str + RTTT.WhiteSpace;
  269.         FillWhiteSpace := Str;
  270.     end; {sub Func FillWhiteSpace}
  271.  
  272.     Procedure MoveTheCursor;
  273.     begin
  274.         GotoXY(X+CursorPos-1,Y);
  275.     end;  {sub Proc MoveTheCursor}
  276.  
  277.     Procedure Write_String;
  278.     begin
  279.         Fastwrite(X,Y,attr(F,B),FillWhiteSpace(TempText));
  280.         MoveTheCursor;
  281.     end;
  282.  
  283.     Procedure Erase_Field;
  284.     begin
  285.         TempText := '';
  286.         CursorPos := 1;
  287.         Write_String;
  288.     end;
  289.  
  290.     Procedure Char_Backspace;
  291.     begin
  292.         If CursorPos > 1 then
  293.         begin
  294.             CursorPos := Pred(CursorPos);
  295.             Delete(TempText,CursorPos,1);
  296.             Write_String;
  297.        end;
  298.     end;   {sub Proc Char_Backspace}
  299.  
  300.     Procedure Char_Del;
  301.     begin
  302.         If CursorPos <= length(TempText) then
  303.         begin
  304.             Delete(TempText,CursorPos,1);
  305.             Write_String;
  306.         end;
  307.     end;   {sub Proc Char_Del}
  308.  
  309.     Procedure Add_Char(Ch:char);
  310.     begin
  311.         If InsertMode then
  312.         begin
  313.             If length(TempText) < L then
  314.             begin
  315.                 Insert(Ch,TempText,CursorPos);
  316.                 If CursorPos < L then
  317.                    CursorPos := Succ(CursorPos);
  318.            end;
  319.         end
  320.         else {not insertmode}
  321.         begin
  322.             Delete(TempText,CursorPos,1);
  323.             Insert(Ch,TempText,CursorPos);
  324.             If CursorPos < L then
  325.                CursorPos := Succ(CursorPos);
  326.         end;   {if insert}
  327.         Write_String;
  328.     end;   {sub proc Add_Char}
  329.  
  330.  
  331. begin                  {main Procedure Read_Line}
  332.     Check_Parameters;
  333.     R_Null := false;
  334.     FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot);
  335.     If RTTT.Insert then
  336.        HalfCursor
  337.     else
  338.        OnCursor;
  339.     Write_String;
  340.     FirstCharPress := true;
  341.     Repeat
  342.          Ch := Getkey;
  343.          If Format in [2,3] then
  344.             Ch := upcase(Ch);
  345.          If Ch in RTTT.End_Chars then
  346.          begin
  347.             AllDone := True;
  348.             If Ch <> #027 then Text := TempText;
  349.          end
  350.          else
  351.          Case Ch of
  352.          #131,              {mouseright}
  353.          CursorRight   :  begin
  354.                               If (CursorPos < L)
  355.                               and (CursorPos <= length(TempText)) then
  356.                               begin
  357.                                   CursorPos := Succ(CursorPos);
  358.                                   MoveTheCursor;
  359.                               end;
  360.                           end;
  361.          #130,               {mouseleft}
  362.          CursorLeft    :  begin
  363.                               If CursorPos > 1 then
  364.                               begin
  365.                                   CursorPos := Pred(CursorPos);
  366.                                   MoveTheCursor;
  367.                               end;
  368.                           end;
  369.          HomeKey       :  begin
  370.                               CursorPos := 1;
  371.                               MoveTheCursor;
  372.                           end;
  373.          EndKey        :  begin
  374.                               If CursorPos < L then
  375.                               If length(TempText) < L then
  376.                                   CursorPos := length(TempText) + 1
  377.                               else
  378.                                   CursorPos := L;
  379.                               MoveTheCursor;
  380.                           end;
  381.         InsKey        :  If Format <> 3 then   {don't allow insert on Y/N!}
  382.                          begin
  383.                              InsertMode := not InsertMode;
  384.                              If InsertMode then
  385.                                 HalfCursor
  386.                              else
  387.                                 OnCursor;
  388.                          end;
  389.         DelKey        :  Char_Del;
  390.         BackSpace     :  Char_Backspace;
  391.         Zap           :  Erase_Field;
  392.         EscKey        :  If RTTT.AllowEsc then
  393.                              Alldone := true
  394.                          else
  395.                             Clang;
  396.         EnterKey      :  begin
  397.                              Alldone := true;
  398.                              Text := TempText;
  399.                          end;
  400.        #33 .. #42,                                 {! to *}
  401.        #44,#47,                                    {, /}
  402.        #58 .. #64,                                 {: to @}
  403.        #91 .. #96,                                 {[ to '}
  404.        #123 .. #126   :  If (Format in [1,2]) then {{ to ~}
  405.                          begin
  406.                              If FirstCharPress and RTTT.EraseDefault then
  407.                                 Erase_Field;
  408.                              Add_Char(Ch);
  409.                          end
  410.                          else
  411.                              Clang;
  412.        #43, #45       : If (Format in [1,2])       { + - }
  413.                         or ( (CursorPos=1) and (Format in [5,6,7])) then
  414.                         begin
  415.                             If FirstCharPress and RTTT.EraseDefault then
  416.                                 Erase_Field;
  417.                             Add_Char(Ch);
  418.                         end
  419.                         else
  420.                            Clang;
  421.        #46            : If (Format in [1,2])       {.}
  422.                         or ( (Pos('.',TempText)=0) and (Format = 7)) then
  423.                         begin
  424.                             If FirstCharPress and RTTT.EraseDefault then
  425.                                 Erase_Field;
  426.                             Add_Char(Ch);
  427.                         end
  428.                         else
  429.                            Clang;
  430.        #48..#57       : If (Format in [1..2,5..8]) then {0 to 9}
  431.                         begin
  432.                             If FirstCharPress and RTTT.EraseDefault then
  433.                                 Erase_Field;
  434.                             Add_Char(Ch);
  435.                         end
  436.                         else
  437.                            Clang;
  438.        #32,                                              {space}
  439.        #65..#77,                                         {A to M}
  440.        #79..#88,                                         {O to X}
  441.        #90,                                              {Z}
  442.        #97..#122      : If (Format in [1,2,4]) then      {a to z}
  443.                         begin
  444.                             If FirstCharPress and RTTT.EraseDefault then
  445.                                 Erase_Field;
  446.                             Add_Char(Ch);
  447.                         end
  448.                         else
  449.                            Clang;
  450.        #78,#89        : If (Format in [1..4]) then        {N Y}
  451.                         begin
  452.                             Add_Char(Ch);
  453.                             If Format = 3 then
  454.                             begin
  455.                                 Alldone := true;
  456.                                 Text := TempText;
  457.                             end;
  458.                         end
  459.                         else
  460.                            Clang;
  461.       #128,#129       :;    {absorb stray mouse movement to avoid Clang'n}
  462.       else Clang;
  463.       end; {case}
  464.       FirstCharPress := false;
  465.       Until Alldone;
  466.       R_Char := Ch;
  467.       If  RTTT.RightJustify
  468.       and (Format > 4) then
  469.       begin
  470.           Fastwrite(X,Y,attr(F,B),replicate(L,RTTT.Whitespace));
  471.           Fastwrite(X+L-Length(TempText),Y,attr(F,B),Text);
  472.       end
  473.       else
  474.         Fastwrite(X,Y,attr(F,B),FillWhiteSpace(Text));
  475.       GotoXY(Cursor_X,Cursor_Y);
  476.       SizeCursor(ScanTop,ScanBot);
  477. end;  {Proc Read_Line}
  478.  
  479. Procedure Display_Box_and_Prompt(var X1,Y: byte;
  480.                                  BoxType:byte;
  481.                                  Prompt: StrScreen;
  482.                                  L:byte);
  483. {ensures that the input will fit on the screen, then draws box and prompt}
  484. const
  485.    Upchar = '^';
  486.    DnChar = '_';
  487. var
  488.   P,
  489.   width:byte;
  490.   InBorder : byte;    {is title in box border - 0 no, 1 upper, 2 lower}
  491. begin
  492.     If not ( (Y-ord(BoxType > 0)) in [1..DisplayLines] ) then
  493.        Y := 2;
  494.     If (X1 < 1) then
  495.        X1 := 2;
  496.     P := length(Prompt);
  497.     If (P > 1) and (Boxtype > 0) then    {check and see if prompt is in box}
  498.     begin
  499.        If Prompt[1] = Upchar then
  500.        begin
  501.            delete(Prompt,1,1);
  502.            dec(P);
  503.            InBorder := 1;
  504.        end
  505.        else
  506.           If Prompt[1] = DnChar then
  507.           begin
  508.               delete(Prompt,1,1);
  509.               dec(P);
  510.               InBorder := 2;
  511.           end
  512.           else
  513.              InBorder := 0;
  514.     end
  515.     else
  516.        InBorder := 0;
  517.     If InBorder > 0 then                      {determine dimensions of box}
  518.     begin
  519.         If P > L then
  520.            width := succ(P)
  521.         else
  522.            width := succ(L);
  523.     end
  524.     else
  525.        width := succ(P+l);
  526.     If pred(X1 + width) > 80 then
  527.        X1 :=  succ(80 - width);
  528.     If BoxType > 0 then         {draw the box}
  529.        FBox(X1,pred(Y),X1+width,succ(Y),RTTT.BoxFCol,RTTT.BoxBCol,BoxType);
  530.     If P > 0 then               {Draw the prompt}
  531.         Case InBorder of
  532.         0 : If BoxType> 0 then
  533.                Fastwrite(succ(X1),Y,attr(RTTT.PFcol,RTTT.PBCol),Prompt) {left Justified in upper border}
  534.             else
  535.                Fastwrite(X1,Y,attr(RTTT.PFcol,RTTT.PBCol),Prompt);
  536.         1 : FastWrite(succ(X1),pred(Y),attr(RTTT.PFcol,RTTT.PBCol),Prompt);
  537.         2 : FastWrite(X1+width-P,succ(Y),attr(RTTT.PFcol,RTTT.PBCol),Prompt);   {right justified in lower border}
  538.         end;
  539.     If InBorder > 0 then        {return var X1 adjusted to position of input field}
  540.     begin
  541.        If Boxtype > 0 then
  542.           X1 := succ(X1);
  543.     end
  544.     else
  545.     begin
  546.        If Boxtype > 0 then
  547.           X1 := succ(X1) + p
  548.        else
  549.           X1 := X1 + P;
  550.     end;
  551. end;
  552. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  553.  
  554.  Procedure ReadLine(X,Y,L,F,B:byte;var Text: string;var Retcode:integer);
  555.  {compatibility module with TTT 4.0}
  556.  begin
  557.      Read_Line(X,Y,L,F,B,1,Text);
  558.      If R_Char = #027 then
  559.         RetCode := 1         {5.00a}
  560.      else
  561.         Retcode := 0;        {5.00a}
  562.  end; {of proc ReadLine}
  563.  
  564.  
  565. Procedure Read_String(X,Y,L:byte;
  566.                       Prompt:StrScreen;
  567.                       BoxType: byte;
  568.                       Var Txt:StrScreen);
  569. begin
  570.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  571.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,1,Txt);
  572. end;
  573.  
  574. Procedure Read_String_Upper(X,Y,L:byte;
  575.                             Prompt:StrScreen;
  576.                             BoxType: byte;
  577.                             Var Txt:StrScreen);
  578. begin
  579.     Txt :=  Upper(Txt);
  580.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  581.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,2,Txt);
  582. end;
  583.  
  584. Procedure Read_Password(X,Y,L:byte;
  585.                         Prompt:StrScreen;
  586.                         BoxType: byte;
  587.                         Var Txt:StrScreen);
  588. begin
  589.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  590.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,11,Txt);
  591. end;
  592.  
  593. Procedure Read_Alpha(X,Y,L:byte;
  594.                      Prompt:StrScreen;
  595.                      BoxType: byte;
  596.                      Var Txt:StrScreen);
  597. begin
  598.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  599.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,4,Txt);
  600. end;
  601.  
  602. Procedure Read_YN(X,Y:byte;
  603.                   Prompt:StrScreen;
  604.                   BoxType: byte;
  605.                   Var Yes:Boolean);
  606.  
  607. var
  608.   Global_Insert : boolean;
  609.   Txt : StrScreen;
  610. begin
  611.     If Yes then
  612.        Txt := 'Y'
  613.     else
  614.        Txt := 'N';
  615.     Global_Insert := RTTT.insert;
  616.     RTTT.Insert := false;            {force to overwrite mode}
  617.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,1);
  618.     Read_Line(X,Y,1,RTTT.FCol,RTTT.BCol,3,Txt);
  619.     RTTT.Insert := Global_Insert;    {reset back}
  620.     If Txt = 'Y' then
  621.        Yes := true
  622.     else
  623.        Yes := false;
  624. end;
  625.  
  626. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  627.  
  628. Procedure Invalid_Message(Y : byte; var CH : char);
  629. begin
  630.    Clang;
  631.    TempMessageCH(1,Y,RTTT.Msg_Fcol,RTTT.Msg_BCol,
  632.                PadCenter('Invalid number - press any key to resume',80,' '),CH);
  633. end;
  634.  
  635. Procedure OutOfRange_Message(Y : byte;MinS,MaxS : StrScreen;var CH:char);
  636. var S : StrScreen;
  637. begin
  638.    Clang;
  639.    S := 'Error value must be in the range '+MinS+' to '+MaxS+' - press any key to resume';
  640.    TempMessageCh(1,Y,RTTT.Msg_Fcol,RTTT.Msg_BCol,PadCenter(S,80,' '),CH);
  641. end;
  642.  
  643. Function MessageLine(Y : byte):byte;
  644. begin
  645.     If (RTTT.Msg_Line = 0) or (RTTT.Msg_Line > DisplayLines) then
  646.     begin
  647.         If Y < DisplayLines then    {set message Line}
  648.            MessageLine := succ(Y)
  649.         else
  650.            MessageLine := pred(Y);
  651.     end
  652.     else
  653.        MessageLine := RTTT.Msg_Line;
  654. end;
  655.  
  656. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  657.  
  658. Procedure Read_Byte(X,Y,L:byte; 
  659.                     Prompt:StrScreen;
  660.                     BoxType: byte;
  661.                     Var B : byte; 
  662.                     Min, Max : byte);
  663. var
  664.    Temp : byte;
  665.    Txt : StrScreen;
  666.    Valid : boolean;
  667.    Code : integer;
  668.    YT : byte;
  669.    CHB : char;
  670. begin
  671.     If Max = 0 then
  672.       Max := 255;
  673.     If Min >= Max then
  674.        Min := 0;
  675.     If (B < Min) or (B > Max) then
  676.         B := Min;
  677.     If ((B = 0) and RTTT.SuppressZero) then
  678.        Txt := ''
  679.     else
  680.        Txt := Int_To_Str(B);
  681.     Temp := B;
  682.     Valid := false;
  683.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  684.     YT := MessageLine(Y);
  685.     Repeat
  686.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  687.          If ((R_Char = #027) and RTTT.AllowEsc)
  688.          or ((Txt = '') and (RTTT.AllowNull)) then
  689.          begin
  690.              If Txt = '' then R_Null := true;
  691.              exit;
  692.          end
  693.          else
  694.          begin
  695.              val(Txt,Temp,code);
  696.              If code <> 0 then
  697.              begin
  698.                 Invalid_Message(YT,CHB);
  699.                 If ChB = #027 then
  700.                         Txt := Int_To_Str(B);
  701.              end
  702.              else
  703.              begin
  704.                  If (Temp < Min) 
  705.                  or (Temp > Max) 
  706.                  or ((length(Txt) > 2) and (Txt > '255')) then
  707.                  begin
  708.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),CHB);
  709.                     If ChB = #027 then
  710.                         Txt := Int_To_Str(B);
  711.                  end
  712.                  else
  713.                  begin
  714.                      B := temp;
  715.                      Valid := true;
  716.                  end;
  717.              end;
  718.          end;
  719.     Until Valid or ((R_Char = #027) and RTTT.AllowEsc);
  720. end;
  721.  
  722. Procedure Read_Word(X,Y,L:byte; 
  723.                     Prompt:StrScreen;
  724.                     BoxType: byte;
  725.                     Var W : word; 
  726.                     Min, Max : word);
  727. var
  728.    Temp : word;
  729.    Txt : StrScreen;
  730.    Valid : boolean;
  731.    Code : integer;
  732.    YT : byte;
  733.    ChW : char;
  734. begin
  735.     If Max = 0 then
  736.       Max := MaxWord;
  737.     If Min >= Max then
  738.        Min := MinWord;
  739.     If (W < Min) or (W > Max) then
  740.         W := Min;
  741.     If ((W = 0) and RTTT.SuppressZero) then
  742.        Txt := ''
  743.     else
  744.        Txt := Int_To_Str(W);
  745.     Temp := W;
  746.     Valid := false;
  747.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  748.     YT := MessageLine(Y);
  749.     Repeat
  750.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  751.          If ((R_Char = #027) and RTTT.AllowEsc)
  752.          or ((Txt = '') and (RTTT.AllowNull)) then
  753.          begin
  754.              If Txt = '' then R_Null := true;
  755.              exit;
  756.          end
  757.          else
  758.          begin
  759.              val(Txt,Temp,code);
  760.              If code <> 0 then
  761.              begin
  762.                 Invalid_Message(YT,ChW);
  763.                 If ChW = #027 then
  764.                         Txt := Int_To_Str(W);
  765.              end
  766.              else
  767.              begin
  768.                  If (Temp < Min) 
  769.                  or (Temp > Max) 
  770.                  or ((length(Txt) > 4) and (Txt > Int_To_Str(MaxWord))) then
  771.                  begin
  772.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChW);
  773.                     If ChW = #027 then
  774.                         Txt := Int_To_Str(W);
  775.                  end
  776.                  else
  777.                  begin
  778.                      W := temp;
  779.                      Valid := true;
  780.                  end;
  781.              end;
  782.          end;
  783.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  784. end;
  785.  
  786.  
  787. Procedure Read_Int(X,Y,L:byte;
  788.                    Prompt:StrScreen;
  789.                    BoxType: byte;
  790.                    Var W : integer;
  791.                    Min, Max : integer);
  792. var
  793.    Temp : integer;
  794.    Txt : StrScreen;
  795.    Valid : boolean;
  796.    Code : integer;
  797.    YT : byte;
  798.    ChI : char;
  799. begin
  800.     If Max = 0 then
  801.       Max := MaxInt;
  802.     If Min >= Max then
  803.        Min := MinInt;
  804.     If (W < Min) or (W > Max) then
  805.         W := Min;
  806.     If ((W = 0) and RTTT.SuppressZero) then
  807.        Txt := ''
  808.     else
  809.        Txt := Int_To_Str(W);
  810.     Temp := W;
  811.     Valid := false;
  812.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  813.     YT := MessageLine(Y);
  814.     Repeat
  815.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  816.          If ((R_Char = #027) and RTTT.AllowEsc)
  817.          or ((Txt = '') and (RTTT.AllowNull)) then
  818.          begin
  819.              If Txt = '' then R_Null := true;
  820.              exit;
  821.          end
  822.          else
  823.          begin
  824.              val(Txt,Temp,code);
  825.              If code <> 0 then
  826.              begin
  827.                 Invalid_Message(YT,ChI);
  828.                 If ChI = #027 then
  829.                    Txt := Int_to_Str(W);
  830.  
  831.              end
  832.              else
  833.              begin
  834.                  If (Temp < Min) or (Temp > Max) then
  835.                  begin
  836.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChI);
  837.                     If ChI = #027 then
  838.                        Txt := Int_to_Str(W);
  839.                  end
  840.                  else
  841.                  begin
  842.                      W := temp;
  843.                      Valid := true;
  844.                  end;
  845.             end;
  846.         end;
  847.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  848. end;
  849.  
  850. Procedure Read_LongInt(X,Y,L:byte;
  851.                    Prompt:StrScreen;
  852.                    BoxType: byte;
  853.                    Var W : longint;
  854.                    Min, Max : longint);
  855. var
  856.    Temp : longint;
  857.    Txt : StrScreen;
  858.    Valid : boolean;
  859.    Code : integer;
  860.    YT : byte;
  861.    ChI : char;
  862. begin
  863.     If Max = 0 then
  864.       Max := MaxLongInt;
  865.     If Min >= Max then
  866.        Min := MinLongInt;
  867.     If (W < Min) or (W > Max) then
  868.         W := Min;
  869.     If ((W = 0) and RTTT.SuppressZero) then
  870.        Txt := ''
  871.     else
  872.        Txt := Int_To_Str(W);
  873.     Temp := W;
  874.     Valid := false;
  875.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  876.     YT := MessageLine(Y);
  877.     Repeat
  878.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  879.          If ((R_Char = #027) and RTTT.AllowEsc)
  880.          or ((Txt = '') and (RTTT.AllowNull)) then
  881.          begin
  882.              If Txt = '' then R_Null := true;
  883.              exit;
  884.          end
  885.          else
  886.          begin
  887.              val(Txt,Temp,code);
  888.              If code <> 0 then
  889.              begin
  890.                 Invalid_Message(YT,ChI);
  891.                 If ChI = #027 then
  892.                    Txt := Int_to_Str(W);
  893.              end
  894.              else
  895.              begin
  896.                  If (Temp < Min) or (Temp > Max) then
  897.                  begin
  898.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChI);
  899.                     If ChI = #027 then
  900.                        Txt := Int_to_Str(W);
  901.                  end
  902.                  else
  903.                  begin
  904.                      W := temp;
  905.                      Valid := true;
  906.                  end;
  907.             end;
  908.         end;
  909.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  910. end;
  911.  
  912. Procedure Read_Real(X,Y,L:byte;
  913.                     Prompt:StrScreen;
  914.                     BoxType: byte;
  915.                     Var W : real; 
  916.                     Min, Max : real);
  917. var
  918.    Temp : Real;
  919.    Txt : StrScreen;
  920.    Valid : boolean;
  921.    Code : integer;
  922.    YT : byte;
  923.    ChR : char;
  924. begin
  925.     If Max = 0 then
  926.       Max := 99999999;
  927.     If Min >= Max then
  928.        Min := -99999999;
  929.     If (W < Min) or (W > Max) then
  930.         W := Min;
  931.     If Min < 0 then    {add room for - sign}
  932.        Inc(L);
  933.     If ((W = 0.0) and RTTT.SuppressZero) then
  934.        Txt := ''
  935.     else
  936.        Txt := Real_To_Str(W,RTTT.RealDP);
  937.     Temp := W;
  938.     Valid := false;
  939.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);      {5.00b}
  940.     YT := MessageLine(Y);
  941.     Repeat
  942.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,7,Txt);
  943.          If ((R_Char = #027) and RTTT.AllowEsc)
  944.          or ((Txt = '') and (RTTT.AllowNull)) then
  945.          begin
  946.              If Txt = '' then R_Null := true;
  947.              exit;
  948.          end
  949.          else
  950.          begin
  951.              val(Txt,Temp,code);
  952.              If code <> 0 then
  953.              begin
  954.                 Invalid_Message(YT,ChR);
  955.                 If ChR = #027 then
  956.                    Txt := Real_to_Str(W,RTTT.RealDP);
  957.              end
  958.              else
  959.              begin
  960.                  If (Temp < Min) or (Temp > Max) then
  961.                  begin
  962.                     OutOfRange_Message(Yt,Real_To_Str(Min,RTTT.RealDP),Real_To_Str(Max,RTTT.RealDP),ChR);
  963.                     If ChR = #027 then
  964.                        Txt := Real_to_Str(W,RTTT.RealDP);
  965.                  end
  966.                  else
  967.                  begin
  968.                      W := temp;
  969.                      Valid := true;
  970.                  end;
  971.             end;
  972.         end;
  973.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  974. end;
  975.   
  976. Procedure Read_Select(X,Y:byte;Pmt,Txt:StrScreen;var Choice:byte);
  977. Const
  978.      UpChar:string[1] = '^';
  979.      JoinChar:string[1] = '_';
  980. var
  981.   W : byte;
  982.   I : integer;
  983.   Horiz : boolean;
  984.      Function Replace_JoinChar(Str:string): string;
  985.      {}
  986.      var I : integer;
  987.      begin
  988.          For I := 1 to length(Str) do
  989.              If Str[I] = JoinChar then
  990.                 Str[I] := ' ';
  991.          Replace_JoinChar := Str;
  992.      end; {of func Replace_JoinChar}
  993.  
  994.      Procedure HiLightWord(W:byte;Hi:boolean);
  995.      var Col : byte;
  996.      begin
  997.          If Hi then
  998.             Col := attr(RTTT.HiFCol,RTTT.HiBcol)
  999.          else
  1000.             Col := attr(RTTT.LoFcol,RTTT.LoBcol);
  1001.          If Horiz then
  1002.              Fastwrite(pred(X)+PosWord(W,Txt),Y,Col,Replace_JoinChar(ExtractWords(W,1,Txt)))
  1003.          else
  1004.              Fastwrite(X,pred(Y)+W,Col,Replace_JoinChar(ExtractWords(W,1,Txt)));
  1005.          If Hi then
  1006.          begin
  1007.             If Horiz then
  1008.                GotoXY(pred(X)+PosWord(W,Txt),Y)
  1009.             else
  1010.                GotoXY(X,Pred(Y)+W);
  1011.          end;
  1012.      end;
  1013.  
  1014.      Procedure Process_Keys;
  1015.      var
  1016.        ChP : char;
  1017.        Finished : boolean;
  1018.      begin
  1019.          Finished := false;
  1020.          Repeat
  1021.               ChP := getKey;
  1022.               If ChP in RTTT.End_Chars then
  1023.                   Finished := True
  1024.               else
  1025.               Case upcase(ChP) of
  1026.               EscKey      : If RTTT.AllowEsc then
  1027.                                 Finished := true;
  1028.               ' ',#9,                                 {tab}
  1029.               CursorDown,
  1030.               CursorRight : begin
  1031.                                 HiLightWord(Choice,false);
  1032.                                 If Choice < W then
  1033.                                    Inc(Choice)
  1034.                                 else
  1035.                                    Choice := 1;
  1036.                                 HiLightWord(Choice,true);
  1037.                             end;
  1038.               #143,                     {Shift tab}
  1039.               CursorUp,
  1040.               CursorLeft  : begin
  1041.                                 HiLightWord(Choice,false);
  1042.                                 If Choice > 1 then
  1043.                                    Dec(Choice)
  1044.                                 else
  1045.                                    Choice := W;
  1046.                                 HiLightWord(Choice,true);
  1047.                             end;
  1048.               #131        : If (Choice < W) and Horiz then    {mouse right}
  1049.                             begin
  1050.                                 HiLightWord(Choice,false);
  1051.                                 Inc(Choice);
  1052.                                 HiLightWord(Choice,true);
  1053.                             end;
  1054.               #130        : If (Choice > 1) and Horiz then    {mouse left}
  1055.                             begin
  1056.                                 HiLightWord(Choice,false);
  1057.                                 Dec(Choice);
  1058.                                 HiLightWord(Choice,true);
  1059.                             end;
  1060.               #129        : If (Choice < W) and (Horiz = false) then    {mouse down}
  1061.                             begin
  1062.                                 HiLightWord(Choice,false);
  1063.                                 Inc(Choice);
  1064.                                 HiLightWord(Choice,true);
  1065.                             end;
  1066.               #128        : If (Choice > 1) and (Horiz = false) then    {mouse up}
  1067.                             begin
  1068.                                 HiLightWord(Choice,false);
  1069.                                 Dec(Choice);
  1070.                                 HiLightWord(Choice,true);
  1071.                             end;
  1072.  
  1073.               end; {case}
  1074.          until Finished;
  1075.          R_Char := ChP;
  1076.      end;
  1077.  
  1078. begin
  1079.     If Txt[1] = UpChar then
  1080.     begin
  1081.         Horiz := False;
  1082.         Delete(Txt,1,1);
  1083.     end
  1084.     else
  1085.        Horiz := true;
  1086.     W := Wordcnt(Txt);
  1087.     If W < 2 then exit;              {only show choices if there are two or more}
  1088.     FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot);   {record cursor settings}
  1089.     If (Choice > W) or (Choice < 1) then               {check that W is sensible}
  1090.        Choice := 1;
  1091.     If Pmt <> '' then
  1092.     begin
  1093.         Fastwrite(X,Y,attr(RTTT.PFcol,RTTT.PBCol),Pmt);
  1094.         X := X+length(Pmt);
  1095.     end;
  1096.     For I := 1 to W do
  1097.         HiLightWord(I,False);
  1098.     OnCursor;
  1099.     HiLightWord(Choice,True);
  1100.     Process_keys;
  1101.     GotoXY(Cursor_X,Cursor_Y);           {reset cursor}
  1102.     SizeCursor(ScanTop,ScanBot);
  1103. end;  {proc Read_Select}
  1104.  
  1105. begin
  1106.    Default_Settings;
  1107. end.
  1108.